#lang racket/gui
(require framework)
(require "l10n.rkt")
(require "kdp.rkt")
(require "tunn_common.rkt")
(require "tunn_kiring.rkt")
(require "tunn_kiri.rkt")
(require "tunn_ssl.rkt")
(require "tunn_ssh.rkt")
(require "primitives.rkt")
(require "interop.rkt")
(require "settings.rkt")
(require net/sendurl)

(current-output-port (open-output-file "./log_stdout.txt" #:exists 'append))
(current-error-port (open-output-file "./log_stderr.txt" #:exists 'append))

#| HELPER FUNCTIONS |#

;Sets the main progressbar
(define (set-prog i)
  (send page1/pbar set-value i))

(define (Log txt (dstat #t))
  (with-handlers ((exn? void))
    (send page1/status set-label txt)
    (when dstat
      (define edi (send page1/logger get-editor))
      (send edi insert (string-append txt "\n")
            (string-length (send edi get-text)))
      (send edi scroll-to-position (string-length (send edi get-text)))
      )))


#| EVENT HANDLERS, ETC |#

(define _conn #f)
(define CurrentTunnel #f)
(define (TunnelType) (settings-get 'tunntype))
(define CurrentServer #f)

(define (Main)
  (settings-initialize!)
  (Log (number->string (current-seconds)))
  (send page3/selection set-selection
        (match (TunnelType)
          ['ssl 0]
          ['kiring 1]
          ['ssh 2]
          ['kiri 3]))
  (send page3/checkbox set-value
        (settings-get 'startbrowser))
  (radcallback page3/selection #f)
  (set! _conn (thread Connect)))

(define (Connect)
  (set-prog 10)
  (Log (string-append "10% - " (l10n 'finding)))
  (define servers (kdp-get-servers))
  (set-prog 20)
  (Log (string-append "20% - " (l10n 'pinging)))
  (sleep (random))
  (define fastest (car (sort servers (λ(a b) (< (tcpping a) (tcpping b))))))
  (set! CurrentServer fastest)
  (Log (string-append "30% - " (l10n 'connecting)))
  (set! CurrentTunnel (match (TunnelType)
                        ['kiring (make-kiring-tunnel 13370 fastest 2377)]
                        ['kiri (make-kiri-tunnel 13370 fastest 2376)]
                        ['ssh (make-ssh-tunnel 13370 fastest 2378)]
                        ['ssl (make-ssl-tunnel 13370 fastest 443)]))
  (match (TunnelType)
    ['kiring (for ([i 20])
               (sleep 0.4)
               (set-prog (+ 30 (* 3 i))))]
    ['kiri (for ([i 20])
             (sleep 0.2)
             (set-prog (+ 30 (* 3 i))))]
    ['ssh (for ([i 20])
            (sleep 0.2)
            (set-prog (+ 30 (* 3 i))))]
    ['ssl (void)])
  (set-prog 100)
  (Log (string-append "100% - " (l10n 'connected)))
  (set-proxy! 13370)
  (set! firsttime (current-seconds))
  (thread StatLoop)
  (thread PingLoop)
  (when (settings-get 'startbrowser) (send-url (string-append "http://kirisurf.mirai.ca/landing/"
                                                              (l10n 'version)))))

(define firsttime #f)

(define (PingLoop)
  (if (not CurrentTunnel) (void)
      (begin
        (send page2/var_rtt set-label
              (string-append
               (number->string
                (tcpping CurrentServer)) " ms"))
        (sleep 3)
        (PingLoop))))

(define (StatLoop)
  (cond
    [(not CurrentTunnel) (void)]
    [else
     (send page2/var_conntime set-label
           (string-append
            (number->string (- (current-seconds) firsttime))
            " sec"))
     (define speed (tunnel-speed CurrentTunnel))
     (send page2/var_dlspeed set-label (string-append
                                        (number->string speed)
                                        " KiB/s"))
     (send page2/var_totband set-label (string-append
                                        (number->string 
                                         (/ (quotient
                                             (unbox (tunnel-_totbytesbox CurrentTunnel))
                                             1024) 1000.0))
                                        " MiB"))
     (send page2/var_currserv set-label
           (number->string
            (foldr + 0 (map string->number (string-split CurrentServer ".")))))
     (set! HistoricalSpeeds
           (cons (* 24.63 (log (add1 (/ speed 2)))) HistoricalSpeeds))
     (send page2/canvas on-paint)
     (sleep 1)
     (StatLoop)]))

(define HistoricalSpeeds null)

(define (PlotSpeeds lst dc acc (last '(170 . 170)))
  (cond
    [(null? lst) (void)]
    [else
     (send dc set-smoothing 'smoothed)
     (define dahpen
       (new pen%
            [color "PowderBlue"]
            [width 1.5]))
     (send dc set-pen dahpen)
     (send dc draw-line 
           (- 170 (* 5 acc))
           (- 170 (car lst))
           (car last)
           (cdr last))
     (PlotSpeeds (cdr lst)
                 dc
                 (add1 acc)
                 (cons (- 170 (* 5 acc))
                       (- 170 (car lst))))]))

(define (Disconnect)
  (when CurrentTunnel
    (kill-thread _conn)
    (tunnel-close CurrentTunnel)
    (set! CurrentTunnel #f)
    (set! _conn #f)
    (clear-proxy!)
    (Log (l10n 'disconnected))
    (set-prog 0)))

;Handle exiting
(define oldexit exit)
(exit-handler
 (λ x 
   (Disconnect)
   (displayln "haha")
   (oldexit)))

#| PRESENTATION CODE |#

;Globals

(define bold-font
  (make-object font%
    (match (system-type)
      ['macosx 12]
      [x 10])
    'default
    'normal
    'bold))

(define label-font
  (make-object font%
    (match (system-type)
      ['macosx 12]
      [x 10])
    'default
    'normal
    'normal))

;Top frame

(define uber-frame%
  (class frame%
    (super-new)
    (define (on-close)
      (Disconnect))
    (augment on-close)))

(define global-frame (new uber-frame% 
                          [label (string-append (l10n 'name)
                                                " "
                                                (l10n 'version))]
                          ;[width 400]
                          ;[height 360]
                          [min-width 480]
                          [min-height 360]
                          [stretchable-width #f]
                          [stretchable-height #f]
                          [style '(no-resize-border)]
                          [alignment '(left center)]
                          ))

(define global-tabs
  (new tab-panel%
       [parent global-frame]
       [choices (list (l10n 'overview)
                      (l10n 'details)
                      (l10n 'settings))]
       [callback (λ(sender event)
                   (displayln (send sender get-selection))
                   (match (send sender get-selection)
                     [0 (send sender change-children (λ(c) (list page1)))]
                     [1 (send sender change-children (λ(c) (list page2)))]
                     [2 (send sender change-children (λ(c) (list page3)))]))]
       ))

(define bug-button
  (new button%
       [parent global-frame]
       [label (l10n 'reportbug)]
       [vert-margin 10]
       [horiz-margin 4]))

#| PAGE ONE: OVERVIEW |#

(define page1
  (new vertical-panel%
       [parent global-tabs]))

(define page1/top-panel
  (new horizontal-panel%
       [parent page1]
       [alignment '(center center)]
       [horiz-margin 30]
       [min-height 170]))

(define kirilogo
  (make-object bitmap% "./kiri.png"))

(define page1/picture
  (new message%
       [parent page1/top-panel]
       [label kirilogo]))

(define page1/logger
  (new editor-canvas%
       [parent page1/top-panel]
       [style '(no-focus
                auto-vscroll
                auto-hscroll)]
       [vert-margin 30]
       [editor (new text%)]))

(define page1/bottom-panel
  (new vertical-panel%
       [parent page1]))

(define page1/pbar
  (new gauge%
       [label ""]
       [parent page1/bottom-panel]
       [range 100]))

(define page1/status
  (new message%
       [label "N/A"]
       [parent page1/bottom-panel]
       [auto-resize #t]))

#| PAGE TWO: DETAILS |#

(define page2
  (new vertical-panel%
       [parent global-tabs]
       ;[min-height 200]
       ))

(define page2/top-panel
  (new horizontal-panel%
       [parent page2]
       [alignment '(center center)]
       [horiz-margin 30]))

(define page2/labels
  (new vertical-panel%
       [parent page2/top-panel]
       [alignment '(right center)]
       [stretchable-width #t]
       ))

(define page2/vars
  (new vertical-panel%
       [parent page2/top-panel]
       [alignment '(left center)]
       [stretchable-width #f]
       [min-width 100]))

(define page2/lbl_conntime
  (new message%
       [parent page2/labels]
       [label (l10n 'conntime)]
       [font bold-font][auto-resize #t]))

(define page2/var_conntime
  (new message%
       [parent page2/vars]
       [label "N/A"]
       [font label-font]
       [auto-resize #t]))

(define page2/lbl_dlspeed
  (new message%
       [parent page2/labels]
       [label (l10n 'dlspeed)]
       [font bold-font][auto-resize #t]))

(define page2/var_dlspeed
  (new message%
       [parent page2/vars]
       [label "N/A"]
       [font label-font][auto-resize #t]))

(define page2/lbl_totband
  (new message%
       [parent page2/labels]
       [label (l10n 'totband)]
       [font bold-font][auto-resize #t]))

(define page2/var_totband
  (new message%
       [parent page2/vars]
       [label "N/A"]
       [font label-font][auto-resize #t]))

(define page2/lbl_currserv
  (new message%
       [parent page2/labels]
       [label (l10n 'currserv)]
       [font bold-font][auto-resize #t]))

(define page2/var_currserv
  (new message%
       [parent page2/vars]
       [label "N/A"]
       [font label-font][auto-resize #t]))

(define page2/lbl_rtt
  (new message%
       [parent page2/labels]
       [label (l10n 'rtt)]
       [font bold-font][auto-resize #t]))

(define page2/var_rtt
  (new message%
       [parent page2/vars]
       [label "N/A"]
       [font label-font][auto-resize #t]))

(define page2/canvas
  (new canvas%
       [parent page2/top-panel]
       [min-width 170]
       [min-height 170]
       [stretchable-height #f]
       [stretchable-width #f]
       [paint-callback (λ(c d)
                         (send d suspend-flush)
                         (send d set-brush "black" 'solid)
                         (send d draw-rectangle 0 0 170 170)
                         (send d set-pen "DarkGreen" 1 'solid)
                         (for ([i 17])
                           (send d draw-line 0 (* 10 i) 170 (* 10 i)))
                         (for ([i 17])
                           (send d draw-line (* 10 i) 0 (* 10 i) 170))
                         (PlotSpeeds HistoricalSpeeds d 0)
                         (send d resume-flush))]))

(define page2/bottom-panel
  (new horizontal-panel%
       [parent page2]
       [alignment '(center center)]))

(define disconnector #t)
(define page2/btn_rdisconnect
  (new button%
       [parent page2/bottom-panel]
       [label (l10n 'disconnect)]
       [min-height 40]
       [min-width 120]
       [stretchable-height #f]
       [stretchable-width #f]
       [callback
        (λ(b e)
          (cond
            [disconnector (Disconnect)
                          (set! disconnector #f)
                          (send b set-label (l10n 'connect))]
            [else (set! _conn (thread Connect))
                  (set! disconnector #t)
                  (send b set-label (l10n 'disconnect))
                  (send global-tabs set-selection 0)
                  (send global-tabs change-children (λ(c) (list page1)))]))]))

(define page3
  (new vertical-panel%
       [parent global-tabs]
       [alignment '(left top)]))

(define page3/groupbox
  (new horizontal-panel%
       [parent
        (new group-box-panel%
             [parent page3]
             [label (l10n 'tunnsets)])]
       ;[min-height 160]
       [stretchable-height #t]
       ))

(define radcallback
  (λ(r e)
    (match (send r get-selection)
      [0 (settings-set! 'tunntype 'ssl)
         (settings-flush)
         (displayln "blah")
         (send page3/description set-editor (new text%))
         (define edi (send page3/description get-editor))
         (send edi auto-wrap #t)
         (send edi insert
               "The 'ssl' tunnel uses an authenticated TLS 1.0 tunnel over the standard port of 443. Traffic from this tunnel is extremely difficult to distinguish from HTTPS website traffic. It is the most stable and tested, and as fo Kirisurf 1.3.0, the only version supported on Windows.\n " (string-length (send edi get-text)))
         (settings-flush)]
      [1 (settings-set! 'tunntype 'kiring)
         (settings-flush)
         (displayln "blah")
         (send page3/description set-editor (new text%))
         (define edi (send page3/description get-editor))
         (send edi auto-wrap #t)
         (send edi insert
               "The 'kiring' tunnel is an experimental obfuscated SSH tunnel using a novel obfuscation method based on brute-forcing a short cryptographic key. This tunnel is extremely difficult to detect by censors, as traffic appears entirely to be pseudorandom, and its security relies on many users using it, which makes mass surveillance by bruteforcing all connections unfeasible. Use this somewhat unreliable and slow tunnel when wishing to avoid and help others avoid surveillance or to help test experimental technology.\n " 
               (string-length (send edi get-text)))
         (settings-flush)]
      [2 (settings-set! 'tunntype 'ssh)
         (settings-flush)
         (send page3/description set-editor (new text%))
         (define edi (send page3/description get-editor))
         (send edi auto-wrap #t)
         (send edi insert
               "The 'ssh' tunnel uses a plain SSHv2 tunnel over the standard port of 22. Use this if you want to maximize performance, and only want to protect against eavesdropping, not censorship or identification by a firewall.\n " 
               (string-length (send edi get-text)))]
      [3 (settings-set! 'tunntype 'kiri)
         (settings-flush)
         (send page3/description set-editor (new text%))
         (define edi (send page3/description get-editor))
         (send edi auto-wrap #t)
         (send edi insert
               "The 'kiri' tunnel is a layered protocol of SSH and TLS. This will appear to firewalls as a long-running TLS session, similar to traffic coming from video chats, and offers a good balance between speed and security. This is the recommended tunnel for clients using Unix or Mac OS X.\n " 
               (string-length (send edi get-text)))])))

(define page3/selection
  (new radio-box%
       [label ""]
       [parent page3/groupbox]
       [choices (list
                 "ssl"
                 "kiring"
                 "ssh"
                 "kiri")]
       [callback radcallback]))

(define page3/description
  (new editor-canvas%
       [parent page3/groupbox]
       [style '(no-focus
                auto-vscroll
                auto-hscroll)]
       [editor (new text%)]))

(define page3/checkbox
  (new check-box%
       [label (l10n 'usebrowser)]
       [parent page3]
       [callback (λ x 
                   (settings-set! 'startbrowser (send page3/checkbox get-value))
                   (settings-flush))]))


(send global-frame show #t)
(send global-tabs change-children (λ(c) (list page2)))
(thread (thunk 
         (sleep 0.05)
         (send global-tabs change-children (λ(c) (list page1)))))
(when (equal? (system-type) 'windows)
  (send page3/groupbox enable #f))

(Main)